home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / comm.swg / 0023_Fossil unit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-08-27  |  10.0 KB  |  468 lines
  1. {
  2.                      Version 1.2  26-August-1989
  3.  
  4. ▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄
  5. █▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒█
  6. █▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒█
  7. █▒▒▒▒▒▒▒▒█████████████████████████████▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒█
  8. █▒▒▒▒▒▒▒ ███                         ▒▒▒▒▒▒▒▒▒▒▒▒▒███▒▒▒▒┌──────────────────┐▒█
  9. █▒▒▒▒▒▒▒ ███▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒ ███▒▒▒▒│   Ronen Magid's  │▒█
  10. █▒▒▒▒▒▒▒ ███▒▒▒▒▒████████▒▒███████▒▒███████▒▒███▒ ███▒▒▒▒│                  │▒█
  11. █▒▒▒▒▒▒▒ ███▒▒▒▒ ███  ███▒ ███   ▒▒ ███   ▒▒ ███▒ ███▒▒▒▒│      Fossil      │▒█
  12. █▒▒▒▒▒▒▒ ██████▒ ███▒ ███▒ ███▒▒▒▒▒ ███▒▒▒▒▒ ███▒ ███▒▒▒▒│      support     │▒█
  13. █▒▒▒▒▒▒▒ ███  ▒▒ ███▒ ███▒ ███████▒ ███████▒ ███▒ ███▒▒▒▒│     Unit For     │▒█
  14. █▒▒▒▒▒▒▒ ███▒▒▒▒ ███▒ ███▒     ███▒     ███▒ ███▒ ███▒▒▒▒│                  │▒█
  15. █▒▒▒▒▒▒▒ ███▒▒▒▒ ███▒ ███▒▒▒▒  ███▒▒▒▒  ███▒ ███▒ ███▒▒▒▒│   TURBO PASCAL   │▒█
  16. █▒▒▒▒▒▒▒ ███▒▒▒▒ ████████▒▒███████▒▒███████▒ ███▒ ███▒▒▒▒│     versions     │▒█
  17. █▒▒▒▒▒▒▒   ▒▒▒▒▒        ▒▒       ▒▒       ▒▒   ▒▒   ▒▒▒▒▒│       4,5        │▒█
  18. █▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒└──────────────────┘▒█
  19. █▒▒▒████████████████████████████████████████████████████▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒█
  20. █▒▒                                                    ▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒█
  21. █▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒█
  22. ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀
  23.  
  24.           Copyright (c) 1989 by Ronen Magid. Tel (972)-52-917663 VOICE
  25.                              972-52-27271 2400 24hrs
  26.  
  27.  
  28. }
  29.  
  30. Unit FOSCOM;
  31.  
  32. Interface
  33.  
  34. Uses
  35.   Dos, Crt;
  36.  
  37. Var
  38.   Regs : Registers;                    {Registers used by Intr and Ms-Dos}
  39.  
  40.  
  41.  
  42. {             Available user Procedures and Functions                     }
  43.  
  44. Procedure Fos_Init       (Comport: Byte);
  45. Procedure Fos_Close      (Comport: Byte);
  46. Procedure Fos_Parms      (Comport: Byte; Baud: Integer; DataBits: Byte;
  47.                           Parity: Char; StopBit: Byte);
  48. Procedure Fos_Dtr        (Comport: Byte; State: Boolean);
  49. Procedure Fos_Flow       (Comport: Byte; State: Boolean);
  50. Function  Fos_CD         (Comport: Byte) : Boolean;
  51. Procedure Fos_Kill_Out   (Comport: Byte);
  52. Procedure Fos_Kill_In    (Comport: Byte);
  53. Procedure Fos_Flush      (Comport: Byte);
  54. Function  Fos_Avail      (Comport: Byte) : Boolean;
  55. Function  Fos_OkToSend   (Comport: Byte) : Boolean;
  56. Function  Fos_Empty      (Comport: Byte) : Boolean;
  57. Procedure Fos_Write      (Comport: Byte; Character: Char);
  58. Procedure Fos_String     (Comport: Byte; OutString: String);
  59. Procedure Fos_StringCRLF (Comport: Byte; OutString: String);
  60. Procedure Fos_Ansi       (Character: Char);
  61. Procedure Fos_Bios       (Character: Char);
  62. Procedure Fos_WatchDog   (Comport: Byte; State: Boolean);
  63. Function  Fos_Receive    (Comport: Byte) : Char;
  64. Function  Fos_Hangup     (Comport: Byte) : Boolean;
  65. Procedure Fos_Reboot;
  66. Function  Fos_CheckModem (Comport: Byte) : Boolean;
  67. Function  Fos_AtCmd      (Comport: Byte; Command: String)  : Boolean;
  68. Procedure Fos_Clear_Regs;
  69.  
  70.  
  71. Implementation
  72.  
  73. Procedure Fos_Clear_Regs;
  74. begin
  75.   FillChar (Regs, SizeOf (Regs), 0);
  76. end;
  77.  
  78. Procedure Fos_Init  (Comport: Byte);
  79. begin
  80.  Fos_Clear_Regs;
  81.  With Regs Do
  82.  begin
  83.     AH := 4;
  84.     DX := (ComPort-1);
  85.     Intr ($14, Regs);
  86.     if AX <> $1954 then
  87.     begin
  88.       Writeln;
  89.       Writeln (' Fossil driver is not loaded.');
  90.       halt (1);
  91.     end;
  92.   end;
  93. end;
  94.  
  95. Procedure Fos_Close (Comport: Byte);
  96. begin
  97.   Fos_Clear_Regs;
  98.   Fos_Dtr(Comport,False);
  99.  
  100.   With Regs Do
  101.   begin
  102.     AH := 5;
  103.     DX := (ComPort-1);
  104.     Intr ($14, Regs);
  105.   end;
  106. end;
  107.  
  108.  
  109. Procedure Fos_Parms (ComPort: Byte; Baud: Integer; DataBits: Byte;
  110.                                     Parity: Char; StopBit: Byte);
  111. Var
  112.  Code: Integer;
  113. begin
  114.   Code:=0;
  115.   Fos_Clear_Regs;
  116.   Case Baud of
  117.       0 : Exit;
  118.     100 : code:=code+000+00+00;
  119.     150 : code:=code+000+00+32;
  120.     300 : code:=code+000+64+00;
  121.     600 : code:=code+000+64+32;
  122.     1200: code:=code+128+00+00;
  123.     2400: code:=code+128+00+32;
  124.     4800: code:=code+128+64+00;
  125.     9600: code:=code+128+64+32;
  126.   end;
  127.  
  128.   Case DataBits of
  129.     5: code:=code+0+0;
  130.     6: code:=code+0+1;
  131.     7: code:=code+2+0;
  132.     8: code:=code+2+1;
  133.   end;
  134.  
  135.   Case Parity of
  136.     'N','n': code:=code+00+0;
  137.     'O','o': code:=code+00+8;
  138.     'E','e': code:=code+16+8;
  139.   end;
  140.  
  141.   Case StopBit of
  142.     1: code := code + 0;
  143.     2: code := code + 4;
  144.   end;
  145.  
  146.   With Regs do
  147.   begin
  148.     AH := 0;
  149.     AL := Code;
  150.     DX := (ComPort-1);
  151.     Intr ($14, Regs);
  152.   end;
  153. end;
  154.  
  155. Procedure Fos_Dtr   (Comport: Byte; State: Boolean);
  156. begin
  157.   Fos_Clear_Regs;
  158.   With Regs do
  159.   begin
  160.     AH := 6;
  161.     DX := (ComPort-1);
  162.     Case State of
  163.     True : AL := 1;
  164.     False: AL := 0;
  165.     end;
  166.     Intr ($14, Regs);
  167.   end;
  168. end;
  169.  
  170.  
  171. Function  Fos_CD    (Comport: Byte) : Boolean;
  172. begin
  173.   Fos_Clear_Regs;
  174.   With Regs do
  175.   begin
  176.     AH := 3;
  177.     DX := (ComPort-1);
  178.     Intr ($14, Regs);
  179.     Fos_Cd := ((AL and 128) = 128);
  180.   end;
  181. end;
  182.  
  183.  
  184. Procedure Fos_Flow  (Comport: Byte; State: Boolean);
  185. begin
  186.   Fos_Clear_Regs;
  187.     With Regs do
  188.     begin
  189.     AH := 15;
  190.     DX := ComPort-1;
  191.     Case State of
  192.       True:  AL := 255;
  193.       False: AL := 0;
  194.     end;
  195.     Intr ($14, Regs);
  196.   end;
  197. end;
  198.  
  199. Procedure Fos_Kill_Out (Comport: Byte);
  200. begin
  201.   Fos_Clear_Regs;
  202.     With Regs do
  203.     begin
  204.     AH := 9;
  205.     DX := ComPort-1;
  206.     Intr ($14, Regs);
  207.   end;
  208. end;
  209.  
  210.  
  211. Procedure Fos_Kill_In  (Comport: Byte);
  212. begin
  213.   Fos_Clear_Regs;
  214.   With Regs do
  215.   begin
  216.     AH := 10;
  217.     DX := ComPort-1;
  218.     Intr ($14, Regs);
  219.   end;
  220. end;
  221.  
  222. Procedure Fos_Flush    (Comport: Byte);
  223. begin
  224.   Fos_Clear_Regs;
  225.   With Regs do
  226.   begin
  227.     AH := 8;
  228.     DX := ComPort-1;
  229.     Intr ($14, Regs);
  230.   end;
  231. end;
  232.  
  233. Function  Fos_Avail    (Comport: Byte) : Boolean;
  234. begin
  235.   Fos_Clear_Regs;
  236.   With Regs do
  237.   begin
  238.     AH := 3;
  239.     DX := ComPort-1;
  240.     Intr ($14, Regs);
  241.     Fos_Avail:= ((AH and 1) = 1);
  242.   end;
  243. end;
  244.  
  245. Function  Fos_OkToSend (Comport: Byte) : Boolean;
  246. begin
  247.   Fos_Clear_Regs;
  248.   With Regs do
  249.   begin
  250.     AH := 3;
  251.     DX := ComPort-1;
  252.     Intr ($14, Regs);
  253.     Fos_OkToSend := ((AH and 32) = 32);
  254.   end;
  255. end;
  256.  
  257.  
  258. Function  Fos_Empty (Comport: Byte) : Boolean;
  259. begin
  260.   Fos_Clear_Regs;
  261.   With Regs do
  262.   begin
  263.     AH := 3;
  264.     DX := ComPort-1;
  265.     Intr ($14, Regs);
  266.     Fos_Empty := ((AH and 64) = 64);
  267.   end;
  268. end;
  269.  
  270. Procedure Fos_Write     (Comport: Byte; Character: Char);
  271. begin
  272.   Fos_Clear_Regs;
  273.   With Regs do
  274.   begin
  275.     AH := 1;
  276.     DX := ComPort-1;
  277.     AL := ORD (Character);
  278.     Intr ($14, Regs);
  279.   end;
  280. end;
  281.  
  282.  
  283. Procedure Fos_String   (Comport: Byte; OutString: String);
  284. Var
  285.   Pos: Byte;
  286. begin
  287.   For Pos := 1 to Length(OutString) do
  288.   begin
  289.      Fos_Write(Comport,OutString[Pos]);
  290.    end;
  291. OutString:='';
  292. end;
  293.  
  294.  
  295. Procedure Fos_StringCRLF  (Comport: Byte; OutString: String);
  296. Var
  297.   Pos: Byte;
  298. begin
  299.   For Pos := 1 to Length(OutString) do
  300.     Fos_Write(ComPort,OutString[Pos]);
  301.   Fos_Write(ComPort,Char(13));
  302.   Fos_Write(ComPort,Char(10));
  303.   OutString:='';
  304. end;
  305.  
  306. Procedure Fos_Bios     (Character: Char);
  307.  begin
  308.    Fos_Clear_Regs;
  309.    With Regs do
  310.    begin
  311.      AH := 21;
  312.      AL := ORD (Character);
  313.      Intr ($14, Regs);
  314.   end;
  315. end;
  316.  
  317.  
  318. Procedure Fos_Ansi     (Character: Char);
  319. begin
  320.   Fos_Clear_Regs;
  321.   With Regs do
  322.   begin
  323.     AH := 2;
  324.     DL := ORD (Character);
  325.     Intr ($21, Regs);
  326.   end;
  327. end;
  328.  
  329.  
  330. Procedure Fos_WatchDog (Comport: Byte; State: Boolean);
  331. begin
  332.   Fos_Clear_Regs;
  333.   With Regs do
  334.   begin
  335.     AH := 20;
  336.     DX := ComPort-1;
  337.     Case State of
  338.       True  : AL := 1;
  339.       False : AL := 0;
  340.     end;
  341.     Intr ($14, Regs);
  342.   end;
  343. end;
  344.  
  345.  
  346. Function Fos_Receive  (Comport: Byte) : Char;
  347. begin
  348.   Fos_Clear_Regs;
  349.   With Regs do
  350.   begin
  351.     AH := 2;
  352.     DX := ComPort-1;
  353.     Intr ($14, Regs);
  354.     Fos_Receive := Chr(AL);
  355.   end;
  356. end;
  357.  
  358.  
  359. Function Fos_Hangup   (Comport: Byte) : Boolean;
  360. Var
  361.   Tcount : Integer;
  362. begin
  363.   Fos_Dtr(Comport,False);
  364.   Delay (600);
  365.   Fos_Dtr(Comport,True);
  366.   if FOS_CD (ComPort)=True then
  367.   begin
  368.     Tcount:=1;
  369.     Repeat
  370.       Fos_String (Comport,'+++');
  371.       Delay (3000);
  372.       Fos_StringCRLF (Comport,'ATH0');
  373.       Delay(3000);
  374.       if Fos_CD (ComPort)=False then
  375.         tcount:=3;
  376.       Tcount:=Tcount+1;
  377.     Until Tcount=4;
  378.   end;
  379.  
  380.   if Fos_Cd (ComPort)=True then
  381.     Fos_Hangup:=False
  382.   else
  383.     Fos_Hangup:=True;
  384. end;
  385.  
  386.  
  387. Procedure Fos_Reboot;
  388. begin
  389.   Fos_Clear_Regs;
  390.   With Regs do
  391.   begin
  392.     AH := 23;
  393.     AL := 1;
  394.     Intr ($14, Regs);
  395.   end;
  396. end;
  397.  
  398. Function Fos_CheckModem (Comport: Byte) : Boolean;
  399. Var
  400.   Ch     :   Char;
  401.   Result :   String[10];
  402.   I,Z    :   Integer;
  403.  
  404. begin
  405.   Fos_CheckModem:=False;
  406.   Result:='';
  407.   For Z:=1 to 3 do
  408.   begin
  409.     Delay(500);
  410.     Fos_Write (Comport,Char(13));
  411.     Delay(1000);
  412.     Fos_StringCRLF (Comport,'AT');
  413.     Delay(1000);
  414.     Repeat
  415.       if Fos_Avail (Comport) then
  416.       begin
  417.         Ch:=Fos_Receive(Comport);
  418.         Result:=Result+Ch;
  419.       end;
  420.     Until Fos_Avail(1)=False;
  421.     For I:=1 to Length(Result) do
  422.     begin
  423.       if Copy(Result,I,2)='OK' then
  424.       begin
  425.         Fos_CheckModem:=True;
  426.         Exit;
  427.       end;
  428.     end;
  429.   end;
  430. end;
  431.  
  432.  
  433. Function Fos_AtCmd (Comport: Byte; Command: String) : Boolean;
  434. Var
  435.   Ch     :   Char;
  436.   Result :   String[10];
  437.   I,Z    :   Integer;
  438. begin
  439.   Fos_AtCmd:=False;
  440.   Result:='';
  441.   For Z:=1 to 3 do
  442.   begin
  443.     Delay(500);
  444.     Fos_Write (Comport,Char(13));
  445.     Delay(1000);
  446.     Fos_StringCRLF (Comport,Command);
  447.     Delay(1000);
  448.     Repeat
  449.       if Fos_Avail (Comport) then
  450.       begin
  451.         Ch:=Fos_Receive(Comport);
  452.         Result:=Result+Ch;
  453.       end;
  454.     Until Fos_Avail(1)=False;
  455.     For I:=1 to Length(Result) do
  456.     begin
  457.       if Copy(Result,I,2)='OK' then
  458.       begin
  459.         Fos_AtCmd:=True;
  460.        Exit;
  461.       end;
  462.     end;
  463.   end;
  464. end;
  465.  
  466. end.
  467.  
  468.